home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HyperLib 1997 Winter - Disc 1
/
HYPERLIB-1997-Winter-CD1.ISO.7z
/
HYPERLIB-1997-Winter-CD1.ISO
/
オンラインウェア
/
PRG
/
ICProgKit 1.3.sit
/
ICProgKit1.3
/
Goodies
/
ICeTEe
/
ShowInit-75.p
< prev
next >
Wrap
Text File
|
1995-05-01
|
8KB
|
248 lines
unit ShowInit75;
interface
{$ifc undefined THINK_Pascal}
uses
Types;
{$endc}
{ --------------------------------------------------------------------------------------------------------------------- }
{ Set this to 1 if you want to compile ShowInit-7 into a stand-alone resource. I don't recommend it; see notes below. }
procedure ShowIcon7 (iconFamilyID: integer; advance: Boolean);
implementation
{ ShowInit-7 - version 1.0.4, April 25th, 1995 }
{ This code is intended to let INIT writers easily display an icon at startup time. }
{ I have found that there are many snippets out there showing how to do this, but all of those I tried were }
{ unnecessarily complex and/or had bugs. I would like to make widely available a version that is as simple }
{ and bug-free as possible. If you feel that this code needs enhancements, please let me know so that I can roll them in. }
{ This version features: }
{ - Short and readable code. }
{ - Correctly wraps around when more than one row of icons has been displayed. }
{ - works with System 6 }
{ - Built with Universal Headers & CodeWarrior. Slight changes should suffice to accommodate other headers/compilers. }
{ Written by Fran腔is Pottier (pottier@clipper.ens.fr), with thanks to the numerous authors I stole code from. }
{ This code is free for use in any project. }
{ Hacked by Peter N Lewis <peter@mail.peter.com.au>. I mostly just merged in some of }
{ Jim Walker's <JWWalker@aol.com> code. }
{ --------------------------------------------------------------------------------------------------------------------- }
{ Version History: }
{ 1.0: }
{ Initial release }
{ 1.0.1: }
{ Added qdGlobalsPtr for QuickDraw to store a pointer into. I hadn't seen this bug because it didn't crash a Power Mac! }
{ 1.0.2: }
{ Added a C equivalent for CheckSum. }
{ Fixed a problem which would prevent the icon from displaying when Conflict Catcher is present. }
{ 1.0.3: }
{ Now checks for the required system functionality and does nothing if absent. }
{ 1.0.4: }
{ Added STANDALONE preprocessor flag to allow separate compilation. }
{ Changed calling convention to 'Pascal' so that people without a C compiler could use it. }
{ 1.1.0: }
{ Support System 6 trivial, and support the advance boolean, removed the asm code - PNL }
{ Basically, added the good features of ShowIcon7 to this in a hopeless attempt to }
{ make ShowInit the "One True Show Icon Code". }
uses
{$ifc undefined THINK_Pascal}
OSUtils, Resources, Memory, QuickDraw,
{$endc}
Icons;
{ --------------------------------------------------------------------------------------------------------------------- }
{ The ShowINIT mechanism works by having each INIT read/write data from these globals. }
type
LMShowInitRecord = packed record
LMVCheckSum: integer;
LMVCoord: integer;
LMHCoord: integer;
LMHCheckSum: integer;
end;
LMShowInitRecordPtr = ^LMShowInitRecord;
const
LMShowInitRecordAddr = $928; { Low Memory address of record }
{ prototypes }
function CheckSum (x: integer): integer;
forward;
procedure ComputeIconRect (var iconRect: Rect; var bounds: Rect);
forward;
procedure AdvanceIconPosition (var iconRect: Rect);
forward;
procedure DrawBWIcon (iconId: integer; var icon_rect: Rect; visible: Boolean);
forward;
{ --------------------------------------------------------------------------------------------------------------------- }
{ Main routine. }
{ This must be the first routine for THINK C's "Custom Header" option to work }
{$ifc not undefined THINK_Pascal}
type
QDGlobals = record
privates: packed array[0..75] of CHAR;
randSeed: LONGINT;
screenBits: BitMap;
arrow: Cursor;
dkGray: Pattern;
ltGray: Pattern;
gray: Pattern;
black: Pattern;
white: Pattern;
thePort: GrafPtr;
end;
type
IconAlignmentType = integer;
IconTransformType = integer;
const
ttNone = $0;
atNone = $0;
function PlotIconID (var theRect: Rect; align: IconAlignmentType; transform: IconTransformType; theResID: INTEGER): OSErr;
inline
$303C, $0500, $ABC9;
{$endc}
type
QDStorage = record
qd: QDGlobals; { Storage for the QuickDraw globals }
qdGlobalsPtr: Ptr; { A5 points to this place; it will contain a pointer to qd }
end;
procedure ShowIcon7 (iconFamilyID: integer; advance: Boolean);
var
oldA5: longInt;
qds: QDStorage; { Fake QD globals }
colorPort: CGrafPort;
bwPort: GrafPort;
destRect: Rect;
environment: SysEnvRec; { machine configuration. }
junk: OSErr;
begin
oldA5 := SetA5(longInt(@qds.qdGlobalsPtr)); { Tell A5 to point to the end of the fake QD Globals }
InitGraf(@qds.qd.thePort); { Initialize the fake QD Globals }
{ find out what kind of machine this is. }
junk := SysEnvirons(curSysEnvVers, environment);
ComputeIconRect(destRect, qds.qd.screenBits.bounds); { Compute where the icon should be drawn }
if (environment.systemVersion >= $0700) & environment.hasColorQD then begin
OpenCPort(@colorPort);
DrawBWIcon(iconFamilyID, destRect, false);
junk := PlotIconID(destRect, atNone, ttNone, iconFamilyID);
CloseCPort(@colorPort);
end
else begin
OpenPort(@bwPort);
DrawBWIcon(iconFamilyID, destRect, true);
ClosePort(@bwPort);
end;
if advance then begin
AdvanceIconPosition(destRect);
end;
oldA5 := SetA5(oldA5); { Restore A5 to its previous value }
end;
{ --------------------------------------------------------------------------------------------------------------------- }
{ A checksum is used to make sure that the data in there was left by another ShowINIT-aware INIT. }
function CheckSum (x: integer): integer; { This is the shortest C equivalent I could find. }
begin
CheckSum := BXOR(BOR(BSL(x, 1), BSR(x, 15)), $1021);
end;
{ --------------------------------------------------------------------------------------------------------------------- }
{ Compute where the icon should be displayed and update the shared globals. }
procedure ComputeIconRect (var iconRect: Rect; var bounds: Rect);
var
lmp: LMShowInitRecordPtr;
begin
lmp := LMShowInitRecordPtr(LMShowInitRecordAddr);
if (CheckSum(lmp^.LMHCoord) <> lmp^.LMHCheckSum) then begin { If we are first, we need to initialize the shared data. }
lmp^.LMHCoord := 8;
end;
if (CheckSum(lmp^.LMVCoord) <> lmp^.LMVCheckSum) then begin
lmp^.LMVCoord := bounds.bottom - 40;
end;
if (lmp^.LMHCoord + 34 > bounds.right) then begin { Check whether we must wrap }
iconRect.left := 8;
iconRect.top := lmp^.LMVCoord - 40;
end
else begin
iconRect.left := lmp^.LMHCoord;
iconRect.top := lmp^.LMVCoord;
end;
iconRect.right := iconRect.left + 32;
iconRect.bottom := iconRect.top + 32;
end;
procedure AdvanceIconPosition (var iconRect: Rect);
var
lmp: LMShowInitRecordPtr;
begin
lmp := LMShowInitRecordPtr(LMShowInitRecordAddr);
lmp^.LMHCoord := iconRect.left + 40; { Update the shared data }
lmp^.LMVCoord := iconRect.top;
lmp^.LMHCheckSum := CheckSum(lmp^.LMHCoord);
lmp^.LMVCheckSum := CheckSum(lmp^.LMVCoord);
end;
{ DrawBWIcon() draws the 'ICN#' member of the icon family. }
procedure DrawBWIcon (iconId: integer; var icon_rect: Rect; visible: Boolean);
var
icon: Handle;
source, destination: BitMap;
empty_mask: RgnHandle;
port: GrafPtr;
begin
icon := Get1Resource('ICN#', iconId);
if (icon <> nil) then begin
HLock(icon);
{ prepare the source and destination bitmaps. }
source.baseAddr := Ptr(longInt(icon^) + 128); { mask address. }
source.rowBytes := 4;
SetRect(source.bounds, 0, 0, 32, 32);
GetPort(port);
destination := port^.portBits;
if visible then begin
empty_mask := nil;
end
else begin
empty_mask := NewRgn;
end;
{ transfer the mask. }
CopyBits(source, destination, source.bounds, icon_rect, srcBic, empty_mask);
{ and the icon. }
source.baseAddr := icon^;
CopyBits(source, destination, source.bounds, icon_rect, srcOr, empty_mask);
if (empty_mask <> nil) then begin
DisposeRgn(empty_mask);
end;
end;
end;
end.